#!/usr/local/bin/perl
package POP;
use strict; use warnings;
no if $] >= 5.018, warnings => "experimental::smartmatch";
use feature qw/switch/;

#
use Gtk2;
use Glib qw/TRUE FALSE/;
use base "Gtk2::Window";

#
my $prel;
my $pdsc;

sub init
{
    $pdsc=$_[0];
    $prel=$_[1];
}

sub new
{       my ($class,
	    $id,$pix,$fp,$efn,$pme,$owh)=@_; #,$gm)=@_; <<<<<<<<<<<<<<<<<<<<<<<<<
        my $s = bless Gtk2::Window->new(), $class;
	$s->set_border_width(0);
	my ($w,$h)=($pix->get_width,$pix->get_height);
	if($w<128&&$h<128){
	    $s->set_icon_list($pix);
	}else{
	    $s->set_icon_list($pix->scale_simple(128,128*$h/$w,"nearest"));
	}
	$s->set_title($fp);
        $s->can_focus(TRUE);
	$s->add_events([qw/button_press_mask button_release_mask/]);
	$s->signal_connect(delete_event    => \&fin);
	$s->signal_connect(destroy         => \&fin);
	$s->signal_connect(key_press_event => \&proc_key);
	$s->signal_connect(button_press_event => \&proc_but);
	$s->{fp}=$fp;
	$s->{efn}=$efn;
	$s->{id}=$id;
	$s->{scale}=1;
	$s->{pix}=$pix;
	$s->{img}=Gtk2::Image->new;
	$s->{tp}=Gtk2::Tooltips->new;
	(my $fn=$efn)=~s/\d+://;
	$s->{tip}=1; # <<<
	$s->{pme}=$pme;
#	$s->{gm}=$gm;
	$s->{owh}=$owh;
	$s->add($s->{img});
	$s->{above}=0;
	&set_tpt($s,0);
	$s->{tp}->set_tip($s,$s->{tpt});
	$s->setp;
	$s->show_all;
	$$pme=$s;
}

sub fin
{
    undef ${$_[0]->{pme}};
    return FALSE;
}

sub proc_but
{
    my ($s,$e)=@_;

    my ($ctrl,$shft,$meta)=($e->get_state >= ['control-mask']?1:0,
			    $e->get_state >= ['shift-mask']?1:0,
			    $e->get_state >= ['mod1-mask']?1:0);
    given($e->button){
	when(1){
	    my $ds=$shft?$$pdsc*2:$$pdsc;
	    $s->{scale}+=$ds;
	    $s->setp;
	}
	when(3){
	    if($s->{scale}>0){
		my $ds=$shft?$$pdsc*2:$$pdsc;
		$s->{scale}-=$ds;
		$s->setp;
	    }
	}
	when(2){
	    &$prel($s->{id},1); #,$s->{gm}); <<<<<<<<<<<<<
	}
	default{return FALSE;}
    }
    return TRUE;
}

sub proc_key
{
    my ($s,$e)=@_;
    my ($shft,$ctrl,$meta)=($e->get_state >= ['shift-mask']?1:0,
			    $e->get_state >= ['control-mask']?1:0,
			    $e->get_state >= ['mod1-mask']?1:0);
    given($e->keyval){
	when($Gtk2::Gdk::Keysyms{plus}){
	    $s->{scale}+=$$pdsc;
	    $s->setp;
	}
	when($Gtk2::Gdk::Keysyms{minus}){
	    if($s->{scale}>0){
		$s->{scale}-=$$pdsc;
		$s->setp;
	    }
	}
	when($Gtk2::Gdk::Keysyms{Return}){
	    &$prel($s->{id},1); #,$s->{gm});
	}

	when($Gtk2::Gdk::Keysyms{c}){
	    if($ctrl){
		Gtk2::Clipboard->get(
		    Gtk2::Gdk::Atom->intern("CLIPBOARD"))->set_text(
		    $s->{tpt}?$s->{tpt}:$s->{fp});
	    }
	}

	when([$Gtk2::Gdk::Keysyms{t},
	      $Gtk2::Gdk::Keysyms{T}]){
	    &set_tpt($s,$shft);
	    $s->{tip}=!$s->{tip} unless $shft;
	    if($s->{tip}){
		$s->{tp}->set_tip($s,$s->{tpt});
		$s->{tp}->enable;
	    }else{
		$s->{tp}->disable; # <<< does not work
		$s->{tp}->set_tip($s,"");
	    }
	}
	when ( $Gtk2::Gdk::Keysyms{F} ){
	    my $a=!$s->{above};
	    $s->set_keep_above($a);
	    $s->{above}=$a;
	}
	when ( $Gtk2::Gdk::Keysyms{z} ){
	    return unless $ctrl;
	    $s->iconify;
	}
	when ( $Gtk2::Gdk::Keysyms{x} ){
	    return unless $ctrl;
	    when ( $Gtk2::Gdk::Keysyms{x} ){
		$s->set_decorated(!$s->get_decorated);
	    }
	}

	when($Gtk2::Gdk::Keysyms{p}){
	    &$prel($s->{id},0);
	}
	when([$Gtk2::Gdk::Keysyms{Escape},
	      $Gtk2::Gdk::Keysyms{q}]){
	    $s->destroy;
	}
	default{return FALSE;}
    }
    return TRUE;
}

sub set_tpt
{
    my ($s,$t)=@_;
    if($t){
	$s->{tpt}=$s->{fp};
    }else{
	($s->{tpt}=$s->{efn})=~s/\d+://;
    }
    my ($fs,$ft)=(stat($s->{fp}))[7,9];
    my $fm;
    if($fs<1024){
	$fm="B";
    }else{
	$fs/=1024;
	$fm="KB";
    }
    my ($sec, $min, $hour, $mday, $mon, $year,
	$wday, $yday, $isdst) = localtime($ft);
    $s->{tpt}.=(sprintf "\n%.4d-%.2d-%.2d %.2d:%.2d\n%.1f$fm",
		$year+1900,$mon,$mday,$hour,$min,$fs)."\n".$s->{owh};
}

sub setp
{
    my $s=$_[0];
    my $p=$s->{pix};
    my ($w,$h)=($p->get_width,$p->get_height);
    if($s->{scale}!=1){
	$w*=$s->{scale};
	$h*=$s->{scale};
	$p=$p->scale_simple($w,$h,"hyper");
    }
    $s->{img}->set_from_pixbuf($p);
    $s->{img}->set_size_request($w,$h);
    $s->resize($w,$h);
}

1;
